package Farsail::PBS::Job;

use strict;
use warnings;

use Carp;
use Log::Log4perl;

our $QSUB = "qsub";
our %DEFAULT_OPT;

my %OPTIONS = map { '-'.$_ => 1 }
    qw /a A b c C d D e h I j k l m M N o p q r S u v V W X z/;
# options that may have many arguments
$OPTIONS{'-'.$_} = 2 for qw/l M S u v W/;
# options without argument
$OPTIONS{'-'.$_} = 0 for qw/h I V X z/;
my $logger = Log::Log4perl->get_logger();

sub new {
    my $_class = shift;
    my $class = ref $_class || $_class;
    my $self = {};
    if ( @_ ) {
        $self = { %{$_[0]} };
    }
    bless $self, $class;
    $self->set_options(%DEFAULT_OPT);
    return $self;
}

{
    no strict qw/subs refs/;
    for my $field ( qw/id deps command pbs_id/ ) {
        *{$field} = sub {
            my $self  = shift;
            if ( @_ ) {
                $self->{$field} = shift;
            }
            return $self->{$field};
        };
    }
}

sub set_default_options {
    my $class = shift;
    my %opt = @_;
    if ( exists $opt{reset} && $opt{reset} ) {
        %DEFAULT_OPT = ();
        return;
    }
    _set_options(\%DEFAULT_OPT, \%opt);
}

sub options {
    my $self = shift;
    my @args;
    for my $o( keys %{$self->{options}} ) {
        push @args, $o;
        if ( $OPTIONS{$o} == 1 ) {
            push @args, $self->get_option($o);
        }
        elsif ( $OPTIONS{$o} == 2 ) {
            push @args, join(",", grep {$_} @{$self->get_option($o)});
        }
    }
    return join(' ', @args);
}

sub _set_options {
    my $set = shift;
    my $opt = shift;
    for my $o ( keys %$opt ) {
        if ( exists $OPTIONS{$o} ) {
            if ( $OPTIONS{$o} ) {
                if ( !$opt->{$o} ) {
                    confess "$QSUB option $o need arguments.\n";
                }
                if ( $OPTIONS{$o} == 1 ) {
                    $set->{$o} = $opt->{$o};
                }
                else {
                    if ( ref $opt->{$o} eq 'ARRAY' ) {
                        $set->{$o} = [@{$opt->{$o}}];
                    }
                    else {
                        $set->{$o} = [$opt->{$o}];
                    }
                }
            } else {
                $set->{$o} = 1;
            }
        }
    }
}

sub set_options {
    my $self = shift;
    my %opt = @_;
    if ( exists $opt{reset} && $opt{reset} ) {
        _set_options($self->{options}, %DEFAULT_OPT);
        return;
    }
    if ( !exists $self->{options} ) {
        $self->{options} = {};
    }
    _set_options($self->{options}, \%opt);
}

sub get_option {
    my $self = shift;
    my $o = shift;
    return $self->{options}{$o};
}

sub add_option_value {
    my $self = shift;
    my ($opt, $value) = @_;
    if ( $OPTIONS{$opt} != 2 ) {
        die "Can't add option for non-list value option $opt\n";
    }
    my $old = $self->{options}{$opt} || [];
    push @$old, ( ref $value eq 'ARRAY' ? @$value : $value );
    $self->{options}{$opt} = $old;
}

sub remove_option_value {
    my $self = shift;
    my ($opt, $prefix) = @_;
    if ( $OPTIONS{$opt} != 2 ) {
        die "Can't remove option for non-list value option $opt\n";
    }
    my $old = $self->{options}{$opt} || [];
    my $re = "^".quotemeta($prefix);
    for ( 0..$#$old ) {
        if ( $old->[$_] =~ /$re/ ) {
            delete $old->[$_];
        }
    }
}

sub add_dep {
    my $self = shift;
    my $deps = $self->deps;
    if ( !defined $deps ) {
        $deps = [];
        $self->deps($deps);
    }
    push @{$deps}, @_;
}

sub pbs_command {
    my $self = shift;
    my $test = shift;
    my $command = $self->command;
    if ( !$command ) {
        carp "Could not generate pbs command without job command.\n";
        return;
    }
    my $deps = $self->deps;
    if ( defined $deps && scalar(@$deps) ) {
        my @dep_ids;
        for my $dep ( @$deps ) {
            if ( $test ) {
                push @dep_ids, $dep->id;
            } else {
                if ( !defined $dep->pbs_id ) {
                    carp "The depdend job is not submitted yet!";
                    return;
                }
                push @dep_ids, $dep->pbs_id;
            }
        }
        $self->add_option_value("-W" => join(":", "depend=afterany", @dep_ids));
    }
    my $opts = $self->options;
    $self->remove_option_value("-W", "depend=afterany");
    return <<CMD;
$QSUB $opts <<EOF
$command
EOF
CMD
}

sub submit {
    my $self = shift;
    my $test = shift;
    my $cmd = $self->pbs_command($test) or return;
    $logger->debug($cmd);
    return 1 if ( $test );
    my $res = `$cmd`;
    if ( $? >> 8 != 0 ) {
        confess "$QSUB failed: $?";
    }
    if ( $res =~ /^(\d+)\./ ) {
        $logger->debug("submit job $1.");
        $self->pbs_id($1);
        return 1;
    } else {
        confess "Unknown error.";
    }
}

1;
__END__

=head1 NAME

Farsail::PBS::Job - Interface to qsub command

=head1 SYNOPSIS

   use Farsail::PBS::Job;
   Farsail::PBS::Job->set_default_options(
       -N => $job_name,
       -q => $queue_name,
   );
   my $job = Farsail::PBS::Job->new(
      command => "echo hello",
   );
   $job->submit();

=head1 DESCRIPTION

This module provide interface for qsub command. 

=head2 METHODS

=over  4

=item  new( [$hashref] )

Create a new job. Available fields are id, command, deps, pbs_id.

=item  id( [$id] )

Get or set the fake job id. Used for testing submit.

=item  command( [$command] )

Get or set the Command to submit.

=item  pbs_command( $test )

Get the pbs command. If $test is true, use the fake job id in qsub
dependence options.

=item  add_dep( @jobs )

Add job dependence.

=item  set_default_options( %opts )

Set default options for the new job to create. If provide a option
named 'reset', will clear the default options.

Note some options for qsub can have a list of value. For example, -W
can be a list of additional attributes, the option is like -W
attr_name=attr_value[,attr_name=attr_value...]. To give such option
the value, you can give a string like that or give an array ref. But
the value is change to an array ref internally. So use
get_option('-W') will always get an array ref.

=item  set_options( %opts )

Set options for the job. If provide a option named 'reset', the
options will set to default options.

=item  get_option( $opt )

Get the value for the option.

=item  add_option_value( $opt => $value )

Add value for the option. See qsub manunal for options that can accept
a list of value.

=item  submit( $test )

Submit the job. If $test is true, return the command to execute
without really submit.

=back

=head1 SEE ALSO

L<PBS::Queue>, qsub(1)

=head1 AUTHOR

Ye Wenbin, E<lt>wenbin.ye@alibaba-inc.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Ye Wenbin

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 BUGS

None reported... yet.

=cut
